home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1995 February: Tool Chest / Dev.CD Feb 95 / Dev.CD Feb 95.toast / Tool Chest / Development Tools & Languages / Dylan Related / Mindy-1.1 (sources only) / mindy-1.1 / interp / class.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-06-28  |  9.2 KB  |  382 lines  |  [TEXT/ttxt]
  1. /**********************************************************************\
  2. *
  3. *  Copyright (c) 1994  Carnegie Mellon University
  4. *  All rights reserved.
  5. *  
  6. *  Use and copying of this software and preparation of derivative
  7. *  works based on this software are permitted, including commercial
  8. *  use, provided that the following conditions are observed:
  9. *  
  10. *  1. This copyright notice must be retained in full on any copies
  11. *     and on appropriate parts of any derivative works.
  12. *  2. Documentation (paper or online) accompanying any system that
  13. *     incorporates this software, or any part of it, must acknowledge
  14. *     the contribution of the Gwydion Project at Carnegie Mellon
  15. *     University.
  16. *  
  17. *  This software is made available "as is".  Neither the authors nor
  18. *  Carnegie Mellon University make any warranty about the software,
  19. *  its performance, or its conformity to any specification.
  20. *  
  21. *  Bug reports, questions, comments, and suggestions should be sent by
  22. *  E-mail to the Internet address "gwydion-bugs@cs.cmu.edu".
  23. *
  24. ***********************************************************************
  25. *
  26. * $Header: class.c,v 1.7 94/06/27 16:31:30 wlott Exp $
  27. *
  28. * This file implements classes.
  29. *
  30. \**********************************************************************/
  31.  
  32. #include <stdio.h>
  33. #include <stdarg.h>
  34.  
  35. #include "mindy.h"
  36. #include "gc.h"
  37. #include "type.h"
  38. #include "list.h"
  39. #include "sym.h"
  40. #include "bool.h"
  41. #include "obj.h"
  42. #include "error.h"
  43. #include "def.h"
  44. #include "print.h"
  45. #include "class.h"
  46.  
  47. obj_t obj_ClassClass = 0;
  48.  
  49.  
  50.  
  51. /* Class constructors. */
  52.  
  53. obj_t make_builtin_class(int scavenge(struct object *ptr),
  54.              obj_t transport(obj_t object))
  55. {
  56.     obj_t res = alloc(obj_ClassClass, sizeof(struct class));
  57.  
  58.     init_class_type_stuff(res);
  59.     CLASS(res)->abstract_p = FALSE;
  60.     CLASS(res)->sealed_p = TRUE;
  61.     CLASS(res)->library = NULL;
  62.     CLASS(res)->scavenge = scavenge;
  63.     CLASS(res)->transport = transport;
  64.     CLASS(res)->print = NULL;
  65.     /* These really want to be an obj_t, but we don't have any good obj_t's */
  66.     /* to fill them in with yet. */
  67.     CLASS(res)->debug_name = NULL;
  68.     CLASS(res)->superclasses = NULL;
  69.     CLASS(res)->cpl = NULL;
  70.     CLASS(res)->direct_subclasses = NULL;
  71.     CLASS(res)->all_subclasses = NULL;
  72.  
  73.     return res;
  74. }
  75.  
  76. static int scav_lose(struct object *ptr)
  77. {
  78.     lose("Found an instance of an abstract class?\n");
  79.     return 0;
  80. }
  81.  
  82. static obj_t trans_lose(obj_t obj)
  83. {
  84.     lose("Found an instance of an abstract class?\n");
  85.     return NULL;
  86. }
  87.  
  88. obj_t make_abstract_class(boolean sealed_p)
  89. {
  90.     obj_t res = make_builtin_class(scav_lose, trans_lose);
  91.  
  92.     CLASS(res)->abstract_p = TRUE;
  93.     CLASS(res)->sealed_p = sealed_p;
  94.  
  95.     return res;
  96. }
  97.  
  98.  
  99. /* CPL computation. */
  100.  
  101. struct cpd {
  102.     obj_t class;
  103.     struct cpd_chain *supers;
  104.     struct cpd_chain *after;
  105.     int count;
  106. };
  107.  
  108. struct cpd_chain {
  109.     struct cpd *cpd;
  110.     struct cpd_chain *next;
  111. };
  112.  
  113. static struct cpd_chain *cpds = NULL;
  114. static int class_count = 0;
  115.  
  116. static void push_cpd(struct cpd *cpd, struct cpd_chain **chain)
  117. {
  118.     struct cpd_chain *new = (struct cpd_chain *)malloc(sizeof(struct cpd));
  119.  
  120.     new->cpd = cpd;
  121.     new->next = *chain;
  122.     *chain = new;
  123. }
  124.  
  125. static struct cpd *pop_cpd(struct cpd_chain **chainptr)
  126. {
  127.     struct cpd_chain *chain = *chainptr;
  128.     struct cpd *cpd = chain->cpd;
  129.  
  130.     *chainptr = chain->next;
  131.     free(chain);
  132.  
  133.     return cpd;
  134. }
  135.  
  136. static void free_cpd_chain(struct cpd_chain *chain)
  137. {
  138.     while (chain != NULL) {
  139.     struct cpd_chain *next = chain->next;
  140.     free(chain);
  141.     chain = next;
  142.     }
  143. }
  144.  
  145. static struct cpd *find_cpd(obj_t class);
  146.  
  147. static struct cpd *compute_cpd(obj_t class, obj_t supers)
  148. {
  149.     struct cpd *cpd = (struct cpd *)malloc(sizeof(struct cpd));
  150.  
  151.     cpd->class = class;
  152.     cpd->supers = NULL;
  153.     cpd->after = NULL;
  154.     cpd->count = 0;
  155.     push_cpd(cpd, &cpds);
  156.     class_count++;
  157.  
  158.     if (supers != obj_Nil) {
  159.     struct cpd *prev_super_cpd = find_cpd(HEAD(supers));
  160.     push_cpd(prev_super_cpd, &cpd->supers);
  161.     push_cpd(prev_super_cpd, &cpd->after);
  162.     prev_super_cpd->count++;
  163.     while ((supers = TAIL(supers)) != obj_Nil) {
  164.         struct cpd *super_cpd = find_cpd(HEAD(supers));
  165.         push_cpd(super_cpd, &cpd->supers);
  166.         push_cpd(super_cpd, &cpd->after);
  167.         push_cpd(super_cpd, &prev_super_cpd->after);
  168.         super_cpd->count += 2;
  169.         prev_super_cpd = super_cpd;
  170.     }
  171.     }
  172.     return cpd;
  173. }
  174.  
  175. static struct cpd *find_cpd(obj_t class)
  176. {
  177.     struct cpd_chain *ptr;
  178.  
  179.     for (ptr = cpds; ptr != NULL; ptr = ptr->next)
  180.     if (ptr->cpd->class == class)
  181.         return ptr->cpd;
  182.  
  183.     return compute_cpd(class, CLASS(class)->superclasses);
  184. }
  185.  
  186. static struct cpd *tie_breaker(struct cpd_chain **candidates, obj_t rcpl)
  187. {
  188.     obj_t remaining, supers;
  189.     struct cpd_chain **prev, *ptr;
  190.  
  191.     for (remaining = rcpl; remaining != obj_Nil; remaining = TAIL(remaining)) {
  192.     supers = CLASS(HEAD(remaining))->superclasses;
  193.     for (prev = candidates; (ptr = *prev) != NULL; prev = &ptr->next)
  194.         if (memq(ptr->cpd->class, supers))
  195.         return pop_cpd(prev);
  196.     }
  197.     lose("Can't happen.\n");
  198.     return NULL;
  199. }
  200.  
  201. static obj_t slow_compute_cpl(obj_t class, obj_t superclasses)
  202. {
  203.     struct cpd_chain *candidates;
  204.     struct cpd *candidate;
  205.     obj_t rcpl;
  206.     int count;
  207.     struct cpd_chain *after;
  208.  
  209.     cpds = NULL;
  210.     class_count = 0;
  211.     candidates = NULL;
  212.     push_cpd(compute_cpd(class, superclasses), &candidates);
  213.     free_cpd_chain(cpds);
  214.     cpds = NULL;
  215.  
  216.     rcpl = obj_Nil;
  217.     for (count = 0; count < class_count; count++) {
  218.     if (candidates == NULL)
  219.         error("Inconsistent CPL");
  220.     if (candidates->next != NULL)
  221.         candidate = tie_breaker(&candidates, rcpl);
  222.     else
  223.         candidate = pop_cpd(&candidates);
  224.  
  225.     rcpl = pair(candidate->class, rcpl);
  226.  
  227.     free_cpd_chain(candidate->supers);
  228.     for (after = candidate->after; after != NULL; after = after->next) {
  229.         after->cpd->count--;
  230.         if (after->cpd->count == 0)
  231.         push_cpd(after->cpd, &candidates);
  232.     }
  233.     free_cpd_chain(candidate->after);
  234.     free(candidate);
  235.     }
  236.  
  237.     return nreverse(rcpl);
  238. }
  239.  
  240. static obj_t compute_cpl(obj_t class, obj_t superclasses)
  241. {
  242.     if (superclasses == obj_Nil)
  243.     return list1(class);
  244.     else if (TAIL(superclasses) == obj_Nil)
  245.     return pair(class, CLASS(HEAD(superclasses))->cpl);
  246.     else
  247.     return slow_compute_cpl(class, superclasses);
  248. }
  249.  
  250.  
  251. /* Class initialization. */
  252.  
  253. void setup_class_supers(obj_t class, obj_t supers)
  254. {
  255.     obj_t cpl, scan;
  256.  
  257.     for (scan = supers; scan != obj_Nil; scan = TAIL(scan)) {
  258.     obj_t super = HEAD(scan);
  259.     if (CLASS(super)->sealed_p
  260.           && CLASS(super)->library != CLASS(class)->library)
  261.         error("Can't add subclasses to sealed class %=", super);
  262.     }
  263.  
  264.     CLASS(class)->superclasses = supers;
  265.     cpl = compute_cpl(class, supers);
  266.     CLASS(class)->cpl = cpl;
  267.  
  268.     for (scan = TAIL(cpl); scan != obj_Nil; scan = TAIL(scan)) {
  269.     obj_t super = HEAD(scan);
  270.     CLASS(super)->all_subclasses
  271.         = pair(class, CLASS(super)->all_subclasses);
  272.     }
  273.     for (scan = supers; scan != obj_Nil; scan = TAIL(scan)) {
  274.     obj_t super = HEAD(scan);
  275.     CLASS(super)->direct_subclasses
  276.         = pair(class, CLASS(super)->direct_subclasses);
  277.     }
  278. }
  279.  
  280. void init_builtin_class(obj_t class, char *name, ...)
  281. {
  282.     obj_t super, supers;
  283.     va_list ap;
  284.  
  285.     supers = obj_Nil;
  286.     va_start(ap, name);
  287.     while ((super = va_arg(ap, obj_t)) != NULL)
  288.     supers = pair(super, supers);
  289.     va_end(ap);
  290.     supers = nreverse(supers);
  291.  
  292.     CLASS(class)->debug_name = symbol(name);
  293.     setup_class_supers(class, supers);
  294.     CLASS(class)->direct_subclasses = obj_Nil;
  295.     CLASS(class)->all_subclasses = obj_Nil;
  296.  
  297.     define_class(name, class);
  298. }
  299.  
  300.  
  301. /* Dylan functions. */
  302.  
  303. static obj_t direct_superclasses(obj_t class)
  304. {
  305.     return CLASS(class)->superclasses;
  306. }
  307.  
  308. static obj_t direct_subclasses(obj_t class)
  309. {
  310.     return CLASS(class)->direct_subclasses;
  311. }
  312.  
  313. static obj_t all_superclasses(obj_t class)
  314. {
  315.     return CLASS(class)->cpl;
  316. }
  317.  
  318.  
  319. /* Printer support. */
  320.  
  321. static void print_class(obj_t class)
  322. {
  323.     obj_t debug_name = CLASS(class)->debug_name;
  324.  
  325.     if (debug_name != NULL && debug_name != obj_False)
  326.     printf("{class %s}", sym_name(debug_name));
  327.     else
  328.     printf("{anonymous class 0x%08lx}", (unsigned long)class);
  329. }
  330.  
  331.  
  332. /* GC stuff. */
  333.  
  334. static int scav_class(struct object *o)
  335. {
  336.     struct class *c = (struct class *)o;
  337.  
  338.     scavenge(&c->debug_name);
  339.     scavenge(&c->superclasses);
  340.     scavenge(&c->cpl);
  341.     scavenge(&c->direct_subclasses);
  342.     scavenge(&c->all_subclasses);
  343.  
  344.     return sizeof(struct class);
  345. }
  346.  
  347. static obj_t trans_class(obj_t class)
  348. {
  349.     return transport(class, sizeof(struct class));
  350. }
  351.  
  352. void scavenge_class_roots(void)
  353. {
  354.     scavenge(&obj_ClassClass);
  355. }
  356.  
  357.  
  358. /* Init stuff. */
  359.  
  360. void make_class_classes(void)
  361. {
  362.     obj_ClassClass = ptr_obj(0);
  363.     obj_ClassClass = make_builtin_class(scav_class, trans_class);
  364.     CLASS(obj_ClassClass)->class = obj_ClassClass;
  365. }
  366.  
  367. void init_class_classes(void)
  368. {
  369.     init_builtin_class(obj_ClassClass, "<class>", obj_TypeClass, NULL);
  370.     def_printer(obj_ClassClass, print_class);
  371. }
  372.  
  373. void init_class_functions(void)
  374. {
  375.     define_method("all-superclasses", list1(obj_ClassClass), FALSE, obj_False,
  376.           FALSE, obj_ObjectClass, all_superclasses);
  377.     define_method("direct-superclasses", list1(obj_ClassClass), FALSE,
  378.           obj_False, FALSE, obj_ObjectClass, direct_superclasses);
  379.     define_method("direct-subclasses", list1(obj_ClassClass), FALSE,
  380.           obj_False, FALSE, obj_ObjectClass, direct_subclasses);
  381. }
  382.